compare

load packages

library(tidyverse)
library(knitr)

define variables

# paths
outputDir = '/Volumes/psych-cog/dsnlab/auto-motion-output/'

# variables
study = "tds"

load data

# global intensity file created using calculate_global_intensities.R
trash = read.csv(paste0(outputDir,study,'_autoTrash.csv'))

# manually coded file created using manually_coded.R
manual = read.csv(paste0(outputDir,study,'_manuallyCoded.csv'))

# afni 3dToutCount outlier created using merge_outcount.R
outcount = read.csv(paste0(outputDir,study,'_outcount.csv')) %>% 
  filter(poly == "p2") %>%
  mutate(trashOut = ifelse(outliers > .075, 1, 0))

compare to manual data

# filter trash dataframe and join with filteredMotion
joined = trash %>% 
  left_join(., manual, by = c("subjectID","run","volume")) %>%
  left_join(., outcount, by = c("subjectID","run","volume")) %>%
  select(subjectID, run, volume, volMean, volSD, trashDiff, trashOut, trash) %>%
  mutate(auto = ifelse(trashDiff == 1 & trash == 1, 2, 
                                ifelse(trashDiff == 1 & trash == 0, 3, trash)),
         outcount = ifelse(trashOut == 1 & trash == 1, 2, 
                                ifelse(trashOut == 1 & trash == 0, 3, trash))) %>%
  gather(compare, code, -c(subjectID, run, volume, volMean, volSD, trashDiff, trashOut, trash))

# check false negatives
falseNeg.auto = joined %>% filter(trashDiff == 0 & trash == 1)
falseNeg.outcount = joined %>% filter(trashOut == 0 & trash == 1)

# check false positives
falsePos.auto = joined %>% filter(trashDiff == 1 & trash == 0)
falsePos.outcount = joined %>% filter(trashOut == 1 & trash == 0)

# check hits
hits.auto = joined %>% filter(trashDiff == 1 & trash == 1)
hits.outcount = joined %>% filter(trashOut == 1 & trash == 1)

summarize results

print group-level results

table = data.frame(falseNeg = c(length(falseNeg.auto$trash),length(falseNeg.outcount$trash)), 
           falsePos = c(length(falsePos.auto$trash),length(falsePos.outcount$trash)), 
           hits = c(length(hits.auto$trash),length(hits.outcount$trash)))
row.names(table)=c("auto","outcount")
kable(table,format = "pandoc")

	falseNeg	falsePos	hits
auto	142	526	434
outcount	212	160	368

summarize by participants

nVol = joined %>% group_by(subjectID) %>% summarize(nVol = length(volume))
summaryPos = falsePos.auto %>% group_by(subjectID) %>% summarize(falsePos = sum(trashDiff, na.rm=T))
summaryNeg = falseNeg.auto %>% group_by(subjectID) %>% summarize(falseNeg = sum(trash, na.rm=T))
summaryPosNeg = nVol %>%
  full_join(., summaryPos, by = "subjectID") %>% 
  full_join(., summaryNeg, by = "subjectID") %>% 
  mutate(falseNeg = ifelse(is.na(falseNeg), 0, falseNeg),
         falsePos = ifelse(is.na(falsePos), 0, falsePos),
         totalErrors = falsePos + falseNeg,
         percentErrors = (totalErrors/nVol)*100)

print subject-level results

joined %>% group_by(subjectID) %>% 
  summarise(trashManual = sum(trash, na.rm = T), 
            trashAuto = sum(trashDiff, na.rm = T)) %>%
  full_join(., summaryPosNeg, by = "subjectID") %>%
  select(-nVol) %>%
  arrange(trashManual) %>%
  kable(format = "pandoc", digits = 1)

subjectID	trashManual	trashAuto	falsePos	falseNeg	totalErrors	percentErrors
t105	0	0	0	0	0	0.0
t106	0	0	0	0	0	0.0
t109	0	4	4	0	4	0.3
t110	0	4	4	0	4	0.3
t111	0	2	2	0	2	0.1
t114	0	0	0	0	0	0.0
t115	0	0	0	0	0	0.0
t125	0	4	4	0	4	0.3
t126	0	4	4	0	4	0.3
t127	0	0	0	0	0	0.0
t128	0	4	4	0	4	0.3
t131	0	20	20	0	20	1.4
t132	0	0	0	0	0	0.0
t133	0	4	4	0	4	0.3
t135	0	0	0	0	0	0.0
t136	0	0	0	0	0	0.0
t137	0	0	0	0	0	0.0
t140	0	0	0	0	0	0.0
t120	2	6	4	0	4	0.3
t124	2	4	4	2	6	0.4
t108	4	10	8	2	10	0.7
t117	4	14	10	0	10	0.7
t104	6	14	10	2	12	0.8
t122	6	4	0	2	2	0.1
t101	14	52	42	4	46	3.0
t130	16	14	14	16	30	2.0
t129	32	62	34	4	38	2.6
t121	42	58	26	10	36	2.4
t113	52	88	52	14	66	4.5
t119	52	64	24	12	36	2.4
t134	66	88	36	12	48	3.2
t102	82	158	76	0	76	4.6
t116	84	136	86	32	118	8.1
t139	120	142	54	30	84	5.6

# visualize for each subject subject
joined.plot = joined %>% mutate(code = as.factor(code)) %>%
  select(subjectID, run, volume, volMean, volSD, compare, code) %>%
  gather(measure, value, -c(subjectID, run, compare, volume, code))

nada = joined.plot %>% group_by(subjectID) %>%
  do({
    plot = ggplot(., aes(volume, value)) + 
      geom_point(aes(color = code)) + 
      geom_line() + 
      facet_grid(measure + compare ~ run, scales= "free") +
      scale_colour_hue(drop = FALSE) +
      scale_colour_discrete(labels=c("not trash", "false neg", "hit", "false pos")) + 
      labs(title = .$subjectID[[1]])
    print(plot)
    #ggsave(plot, file=paste0(outputDir,'plots/',.$subjectID[[1]],'.png'), width = 12)
    data.frame()
  })